perm filename F4.F4[NEW,LCS]5 blob sn#547906 filedate 1980-12-01 generic text, type T, neo UTF8
00100	C*****  OUTLIM(I,J), UPDN(NST), NOIR(DUMMY), NOTAIL(X), POSIT(V), SLEND
00200	C*****  JUSTXT
00300	
00400	C K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
00500	
00600	C OUTLIM:	0	;	FUNCTION OUTLIM(I,J)
00700	C	SETO	0,	;	OUTLIM=-1
00800	C	MOVE	1,@(16)     ;	IF(RN(I+J).LT.R4)RETURN
00900	C	ADD	1,@1(16)
01000	C	MOVE 1,XRN-1(1)		;ALL AC1 WERE AC2  25/10/79********
01100	C	CAMGE 1,.COMM.+5
01200	C	JRA	16,2(16)    ;	IF(RN(I+J).GT.R5)RETURN
01300	C	CAMG 1,.COMM.+6
01400	C	SETZ	0,		;	OUTLIM=0 
01500	C	JRA	16,2(16)
01600		FUNCTION OUTLIM(I,J)
01700		COMMON R2,JA,CENTR,J2,R3,R4,R5 /XRN/RN(1)
01800		OUTLIM=-1
01900		R=RN(I+J)
02000	     	IF(R.LT.R4)RETURN
02100		IF(R.GT.R5)RETURN
02200		OUTLIM=0 
02300		END
02400	
02500		SUBROUTINE UPDN(NST)
02600		INTEGER PWDS
02700		COMMON/XRN/RN(1)  /KJY/ DONT,JY /POSI/S(8),JJ2,P
02800		COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L
02900		1/PTR/PWDS(1) /LIMIT/LIMIT,ITEM
03000	  	EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
03100		1,(R6,RJQ(4))
03200	 	DO 1 K=NST,ITEM
03300		L=PWDS(K)
03400		IF(RTLINE(L))GO TO 1
03500		RY=RN(L+1)
03600		IF(RY.GT.16)GO TO 1
03700		IF(RY.EQ.8)GO TO 1
03800		IF(RY.EQ.3)GO TO 1
03900		IF(RY.EQ.R6)GO TO 10
04000		IF(R6.NE.0)GO TO 1
04100	C  DIDN'T MATCH THE CODE NUM.
04200	10	IF(RY.NE.4)GO TO 11
04300		IF(RN(L).LT.3)GO TO 1
04400	C A BAR LINE
04500	11	IF(OUTLIM(L,3))GO TO 2
04600		RN(L+4)=RN(L+4)+R11
04700		IF(K.LT.JJ2)JJ2=K
04800	2	IF(RY.LT.4)GO TO 1
04900		IF(RY.GE.7)GO TO 1
05000	C  NO WIGGLE ON TRILL
05100		RNL=RN(L+5)
05200		IF(RY.NE.4.)GO TO 12
05300		IF(RNL.EQ.50.OR.RNL.EQ.150)GO TO 1
05400	C CRESC. OR BOX
05500	12	IF(OUTLIM(L,6))GO TO 1
05600		RN(L+5)=RNL+R11
05700		IF(JJ2)JJ2=K
05800		IF(K.LT.JJ2)JJ2=K
05900	1	CONTINUE
06000		END
06100	
06200	C UPDN: 	0	;SUBROUTINE UPDN(NST)
06300	C 	;INTEGER PWDS
06400	C 	;COMMON/XRN/RN(4000)  /KJY/ DONT,JY /POSI/S(8),JJ2,P
06500	C 	;COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
06600	C 	;1/PTR/PWDS(250),ITEM,LL,I,IX
06700	C         MOVE 7,@(16)	;EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
06800	C 	SOJ 7,		;1,(R6,RJQ(4))
06900	C 	MOVE 15,LIMIT+1 	; AC7 IS K-1
07000	C ;;	MOVE 15,PTR+=250 	; AC7 IS K-1
07100	C 	SOJ 15,		;(ITEM-1)
07200	C UPDN0:	JSA 16,RTLINE	;DO 1 K=NST,ITEM
07300	C 	JUMP PTR(7)	;L=PWDS(K)
07400	C 	JUMPL UPDN1	;	IF(RTLINE(L))GO TO 1
07500	C 	MOVE 11,PTR(7)	;RY=RN(L+1) -- 11 IS L
07600	C 	MOVE 12,XRN(11)	;IF(RY.GT.16)GO TO 1
07700	C 	CAMG 12,[16.0]	; AC12=RY
07800	C 	CAME 12,[8.0]		;IF(RY.EQ.8)GO TO 1
07900	C 	CAMN 12,[3.0]		;IF(RY.EQ.3)GO TO 1
08000	C 	JRST UPDN1
08100	C 	CAMN 12,.COMM.+7	;IF(RY.EQ.R6)GO TO 10
08200	C 	JRST UPDN10
08300	C 	SKIPE .COMM.+7		;IF(R6.NE.0)GO TO 1
08400	C 	JRST UPDN1
08500	C UPDN10:	CAME 12,[4.0]	; DIDN'T MATCH THE CODE NUM.
08600	C 	JRST UPDN11	;10	;IF(RY.NE.4)GO TO 11
08700	C 	MOVE 2,XRN-1(11)	;IF(RN(L).LT.3)GO TO 1
08800	C 	CAMGE 2,[3.0]
08900	C 	JRST UPDN1	; A BAR LINE
09000	C UPDN11:	JSA 16,OUTLIM	;11	IF(OUTLIM(L,3))GO TO 2
09100	C 	JUMP PTR(7)
09200	C 	JUMP [3]
09300	C 	JUMPL UPDN2
09400	C 	MOVE 2,.COMM.+=12	;RN(L+4)=RN(L+4)+R11
09500	C 	FADRM 2,XRN+3(11)
09600	C ;IF(JJ2)JJ2=K
09700	C 	MOVE 0,7
09800	C 	AOJ
09900	C 	CAMGE POSI+=8
10000	C 	MOVEM POSI+=8		;IF(K.LT.JJ2)JJ2=K
10100	C UPDN2:	CAML 12,[4.0]	;2	;IF(RY.LT.4)GO TO 1
10200	C 	CAML 12,[7.0]	;IF(RY.GE.7)GO TO 1
10300	C 	JRST UPDN1	; NO WIGGLE ON TRILL
10400	C 	CAME 12,[4.0]	;IF(RY.NE.4.)GO TO 12
10500	C 	JRST UPDN12
10600	C 	MOVE XRN+4(11)	;IF(RN(L+5).EQ.50.OR. - - .EQ.150)GO TO 1
10700	C 	CAME [50.0]		;AC0 IS RN(L+5)
10800	C 	CAMN [150.0]
10900	C 	JRST UPDN1	; CRESC. OR BOX
11000	C UPDN12:	JSA 16,OUTLIM	;12	;IF(OUTLIM(L,6))GO TO 1
11100	C 	JUMP PTR(7)
11200	C 	JUMP [6]
11300	C 	JUMPL UPDN1
11400	C 	MOVE 3,.COMM.+=12	;RN(L+5)=RN(L+5)+R11
11500	C 	FADRM 3,XRN+4(11)
11600	C 	MOVE 0,7	;IF(JJ2)JJ2=K
11700	C 	AOJ
11800	C 	CAMGE POSI+=8
11900	C 	MOVEM POSI+=8		;IF(K.LT.JJ2)JJ2=K
12000	C UPDN1:	CAMGE 7,15		;1	;CONTINUE
12100	C 	AOJA 7,UPDN0
12200	C 	JRA 16,1(16)	;END
12300	
12400		SUBROUTINE NOIR
12500		END
12600	
12700		FUNCTION NOTAIL(X)
12800		NOTAIL=0
12900		Z=ABS(X)
13000		IF(Z.LT..56.OR.Z.EQ..75)RETURN
13100		IF(Z.EQ..875.OR.Z.EQ..6)RETURN 
13200		NOTAIL=-1
13300		END
13400	
13500		FUNCTION POSIT(V)
13600		COMMON/RINP/R(10,85),POSNT(0/99)
13700		IF(V)V=-V
13800	C  REREAD OR SOMETHING MAKES /1 C- 2/ GIVE A -2 FOR LAST NUM.!!!???
13900		K=V
14000		A=POSNT(K)
14100		POSIT=A+(POSNT(K+1)-A)*AMOD(V,1.0)
14200	C TYPE  /2.3 -- FOR POSITION BETWEEN NTS 2 AND 3. ETC.
14300		END
14400	            
14500	C SLEND:	0	;	SUBROUTINE SLEND
14600		SUBROUTINE SLEND
14700	C	MOVE 8,[8.0]	;INTEGER PWDS
14800		INTEGER PWDS
14900	C	MOVE 7,SCM+=80	;C  TO FIND END POINTS OF STAVES
15000	CC	COMMON/XRN/RN(1)  /KJY/ DONT,JY /POSI/S(8),JJ2,P
15100	CC	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L
15200	CC	1/PTR/PWDS(1) /LIMIT/LIMIT,ITEM
15300		COMMON/XRN/RN(1)  /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
15400		1 /PTR/PWDS(1) /LIMIT/LIMIT,ITEM /RMOD/RMODE2,RSET4,IBEAM,
15500		1 NOSET,STEM,STUP,NTC,ENDP,RAD,RDD,ITB,POSB
15600	C	MOVE 4,[4.0];COMMON/XRN/RN(2000),IT,POS,RA,NN,JB,RB,A,B,JMP,JK,C,
15700	C	SETZ 5,		;DO 1 K=1,ITEM
15800		DO 1 K=1,ITEM
15900		L=PWDS(K)
16000	C SLN1:	MOVE 6,PTR(5)	;L=PWDS(K)
16100		IF(RN(L+1).NE.8)GO TO 1
16200	C  FOUND A STAFF
16300		IF(RN(L+2).NE.STAFF)GO TO 1
16400	C	CAMN 8,XRN(6)	;C  FOUND A STAFF  ;IF(RN(L+2).NE.STAFF)GO TO 1
16500	C	CAME 7,XRN+1(6)	;C GOT THE RIGHT ONE
16600		IF(ITB.LT.0)GO TO 2
16700	C	JRST SLN1X	;IF(IT)GO TO 2
16800		POSB=202
16900	C	SKIPGE RMOD+=10 	;POS=202
17000	C	JRST SLN2	;C NOW CHECK LEFT SIDE OF STAFF
17100		IF(RN(L).LT.4)RETURN
17200	C	MOVSI 15,210624	;[202.0]	;IF(RN(L).LT.4)RETURN
17300	C	CAML 4,XRN-1(6)	;P6 WASN'T MENTIONED - SO IT =200
17400	C	JRST SLN3
17500		POSB=RN(L+6)+2
17600		IF(POSB.EQ.2)POSB=202
17700	C	MOVE 15,XRN+5(6)	;IF(POS.EQ.2)POS=202
17800		RETURN
17900	C	FADR 15,[2.0]	;RETURN
18000	2	POSB=RN(L+3)-2.3
18100	C	CAMN 15,[2.0]	;2 	POS=RN(L+3)-2.3
18200		RETURN
18300	C	MOVSI 15,210624	;[202.0]	;RETURN
18400	1	CONTINUE
18500	C	JRST SLN3	;1	CONTINUE
18600		END
18700	C SLN2:	MOVE 15,XRN+2(6)	;END
18800	C	FSBR 15,[2.3]
18900	C SLN3:	MOVEM 15,RMOD+=11 
19000	C	JRA 16,(16)
19100	C SLN1X:	AOS 5
19200	C	CAMGE 5,LIMIT+1
19300	C	JRST SLN1
19400	C	SKIPLE RMOD+=11		;IF(POS.LE.0)RETURN
19500	C	JRST SLN2-2		;POS=202 (IN CASE THERE IS NO STAFF)
19600	C	JRA 16,(16)		;END
19700	
19800		SUBROUTINE JUSTXT(R2,R4,R5)
19900		COMMON/RINP/RNO(2,250),NO(350),NP(250)
20000	C ARRAY NO(X) USED IN 'MOVIT'. HOLDS ALL POINTS TO BE MOVED AT ANY TIME.
20100		COMMON /STF/RSTFAC(0/7),RSTJ2 /XRN/RN(1)
20200		COMMON R0,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
20300		1 /POSI/STFF(0/7),JJ2,POS /LIMIT/LIMIT,ITEM,LL,I,IX/PTR/KWDS(1)
20400		2 /ALF/INP(46),ACCX,ML,RRT,RZRO,NCNT,JSZ,OV,RSPC,KN,RA,RB,
20500		3 JLDGR,LDGR,JX,RW,RX,RY,RZ,JJ,RD,RQ,RE,RZZ,RN3,RN6,R44,R55
20550	C12/80	EQUIVALENCE (R6,RJQ(4)),(R7,RJQ(5))
20600		EQUIVALENCE (R8,RJQ(6)),(R9,RJQ(7))
20710	C12/80	1,(R3,RJQ(1)),(R8,RJQ(6)),(R9,RJQ(7)),(I2,INP(2))
20800		DATA RDX/1.5/
20900	 
21000		R0=11
21100	C R0 IS REALLY R2
21200		CALL GETPTS(1)
21300	C GO SETUP NO ARRAY FOR MOVIT
21400		R44=R4
21500		R55=R5
21600		RD=RDX*RSTJ2
21700	C RD IS IDEAL MINIMUM BETWEED CHAR. STRINGS
21800	6	RE=9999.
21900		KN=0
22000		R9=0
22100		R8=0
22200		RZZ=0
22300		DO 1 K=1,ITEM
22400		J=KWDS(K)
22500		R=RN(J+1)
22600		IF(R.NE.16.)GO TO 1
22700		IF(RN(J+2).NE.R2)GO TO 1
22800	C ASSUMES P9 HAS SPACE INFO
22900		JJ=KWDS(K+1)
23000		IF(RN(JJ+1).NE.16.)GO TO 2
23100		IF(RN(JJ).GT.7.)GO TO 1
23200	C JUMP IF FOUND CONTINUING CHARS.  (P10=1)
23300	2	RA=RN(J+3)
23400		IF(RA.LT.R4.OR.RA.GT.R5)GO TO 1
23500	C NOW FIND NEXT WORD.
23600		RX=9999.
23700	33	DO 3 JX=1,ITEM
23800		JR=KWDS(JX)
23900		R=RN(JR+1)
24000		IF(R.NE.16.)GO TO 3
24100		IF(RN(JR+2).NE.R2)GO TO 3
24200		RZ=RN(JR+3)
24300		IF(RZ.LE.RA)GO TO 3
24400		IF(RZ.GT.R5)GO TO 3
24500		IF(RZ.GE.RX)GO TO 3
24600		RX=RZ
24700	3	CONTINUE
24800		IF(RX.EQ.9999.)GO TO 1
24900	C NOW WE HAVE NEXT WD.
25000		RW=RA+RN(J+9)*RN(J+5)*RSTJ2
25100	C RW = POS. OF 1ST CHAR + WIDTH OF CHAR. STRING
25200		RQ=RX-RW-RD
25300		IF(RQ.GE.0)GO TO 1
25400	CC	RZZ=RZZ-RQ*1.5
25500		RQ=RQ*1.5
25600		R5=R5-RQ
25700	C  RZZ=AMOUNT TO MOVE
25800		R8=-RQ
25900		KN=-1
26000		RX=RX-.01
26100	C WORDS ARE SOMETIMES A BIT TO THE RIGHT OF A NOTE.
26200	4	CALL MOVIT(RN,NO,RX,RE,R8,R9)
26300	1	CONTINUE
26400		R9=200
26500		R8=0
26600		R4=0
26700	5	IF(R5.NE.R9)CALL MOVIT(RN,NO,R4,R5,R8,R9)
26800		IF(KN.EQ.0)RETURN 
26900		RD=RD-.5
27000		R4=R44
27100		R5=R55
27200		GO TO 6
27300		END